{*
  Object Pascal simple system and application version manipulation routines
  @Author  Maciej Zagozda (1998-2008)
  @Licence Microsoft Reciprocal License (Ms-RL)
  @Website http://www.codeplex.com/intelitechdelphirtns/
  @Version 2008/04/20 Added documentation support
}

unit VersionRoutines;

interface

uses
  Controls,
  Classes,
  Dialogs,
  ExtCtrls,
  Forms,
  Messages,
  SysUtils,
  Windows;

function CompareBuildNumbers( strnVersion1, strnVersion2: ShortString ): ShortInt;
function CompareVersion( strnVersion1, strnVersion2: AnsiString ): ShortInt;
//function GetFileVersion(var theVersionList: TStringList): Boolean; overload;
function GetFileVersion( strnFileName: AnsiString; var intgMajor, intgMinor, intgRelease, intgBuild: Integer ): Boolean; overload;
function GetVersionMajor(strFullVersion: ShortString; strSeparator: ShortString): ShortInt;
function GetVersionMinor(strFullVersion: ShortString; strSeparator: ShortString): ShortInt;
function GetVersionRelease(strFullVersion: ShortString; strSeparator: ShortString): ShortInt;
function GetVersionBuild(strFullVersion: ShortString; strSeparator: ShortString): ShortInt;

implementation

uses
  StringRoutines;

{*
Compares two versions numbers formatted using standard string notation and returns comparison result.
@param: strnVersion1. First file version number formatted as: "major.minor.release", example: "2008.05.01"
@param: strnVersion2. Second file version number, formatted as above.
@return: 1 if strnVersion is later than strnVersion2. -1 if strnVersion1 is earlier than strnVersion2. 0 if versions are equal.
*}

function CompareBuildNumbers( strnVersion1, strnVersion2: ShortString ): ShortInt;
var
  wordY1, wordM1, wordD1: Word;
  wordY2, wordM2, wordD2: Word;
  intgC: Integer;
begin

  wordY1 := 0;
  wordM1 := 0;
  wordD1 := 0;
  wordY2 := 0;
  wordM2 := 0;
  wordD2 := 0;

  try
    Val( ExtractSepValue( 1, strnVersion1, '.' ), wordY1, intgC );
    Val( ExtractSepValue( 2, strnVersion1, '.' ), wordM1, intgC );
    Val( ExtractSepValue( 3, strnVersion1, '.' ), wordD1, intgC );
  finally
  end;//try

  try
    Val( ExtractSepValue( 1, strnVersion2, '.' ), wordY2, intgC );
    Val( ExtractSepValue( 2, strnVersion2, '.' ), wordM2, intgC );
    Val( ExtractSepValue( 3, strnVersion2, '.' ), wordD2, intgC );
  finally
  end;//try

  {
  ShowMessage( '1:' + IntToStr( wordY1 ) + ',' + IntToStr( wordM1 ) + ',' + IntToStr( wordD1 ));
  ShowMessage( '2:' + IntToStr( wordY2 ) + ',' + IntToStr( wordM2 ) + ',' + IntToStr( wordD2 ));
  }

  if ( wordY1=wordY2 ) and ( wordM1=wordM2 ) and ( wordD1=wordD2 ) then
  begin
    // same version detected
    Result := 0;
  end
  else
  begin
    // compare major version numbers
    if ( wordY1 = wordY2 ) then
    begin
      // compare minor version numbers
      if ( wordM1 = wordM2 ) then
      begin
        // compare release version numbers
        if wordD1 < wordD2 then Result := -1;
        if wordD1 > wordD2 then Result := 1;
      end
      else
      begin
        if wordM1 < wordM2 then Result := -1;
        if wordM1 > wordM2 then Result := 1;
      end;//if
    end
    else
    begin
      if wordY1 < wordY2 then Result := -1;
      if wordY1 > wordY2 then Result := 1;
    end;//if
  end;//if

end;

function CompareVersion( strnVersion1, strnVersion2: AnsiString ): ShortInt;

  function RetrieveVersion( strnString: AnsiString ): Word;
  var
    strnPosition: AnsiString;
    intgResult: Word;
    intgPosition: Word;
  begin

    intgResult := 0;
    intgPosition := Pos( '.', strnString );

    // handling stripping leftings

    if intgPosition > 0 then
    begin
      strnPosition := Copy( strnString,  1, intgPosition - 1 );
    end
    else
    begin
      strnPosition := strnString;
    end;//if

    // handling finding results

    try
      intgResult := StrToInt( strnPosition );
    except
      intgResult := 0;
    end;//try

    Result := intgResult;
  end;//sub

  function StripAfterdot( strnString: AnsiString ): AnsiString;
  var
    intgPosition: Word;
  begin
    intgPosition := Pos( '.', strnString );

    if intgPosition > 0 then
    begin
      Result := Copy( strnString, intgPosition + 1, 255 );
    end
    else
    begin
      Result := '';
    end;//if

  end;//sub

var
  intgVersion1, intgRelease1, intgMajor1, intgMinor1: Word;
  intgVersion2, intgRelease2, intgMajor2, intgMinor2: Word;
begin

  intgVersion1 := RetrieveVersion( strnVersion1 );
  intgVersion2 := RetrieveVersion( strnVersion2 );
  strnVersion1 := StripAfterdot( strnVersion1 );
  strnVersion2 := StripAfterdot( strnVersion2 );

  intgRelease1 := RetrieveVersion( strnVersion1 );
  intgRelease2 := RetrieveVersion( strnVersion2 );
  strnVersion1 := StripAfterdot( strnVersion1 );
  strnVersion2 := StripAfterdot( strnVersion2 );

  intgMajor1 := RetrieveVersion( strnVersion1 );
  intgMajor2 := RetrieveVersion( strnVersion2 );
  strnVersion1 := StripAfterdot( strnVersion1 );
  strnVersion2 := StripAfterdot( strnVersion2 );

  intgMinor1 := RetrieveVersion( strnVersion1 );
  intgMinor2 := RetrieveVersion( strnVersion2 );
  strnVersion1 := StripAfterdot( strnVersion1 );
  strnVersion2 := StripAfterdot( strnVersion2 );

  if intgVersion1 = intgVersion2 then
  begin
    if intgRelease1 = intgRelease2 then
    begin
      if intgMajor1 = intgMajor2 then
      begin
        if intgMinor1 = intgMinor2 then
        begin
          //ShowMessage( 'Nothning differs' );
          Result := 0;
        end
        else
        begin
          //ShowMessage( 'Minor differs' );
          if intgMinor1 > intgMinor2 then
            Result := -1
          else
            Result := 1;
        end;//if
      end
      else
      begin
        //ShowMessage( 'Major differs' );
        if intgMajor1 > intgMajor2 then
          Result := -1
        else
          Result := 1;
      end;//if
    end
    else
    begin
      //ShowMessage( 'Release differs' );
      if intgRelease1 > intgRelease2 then
        Result := -1
      else
        Result := 1;
    end;//if
  end
  else
  begin
    //ShowMessage( 'Version differs' );
    if intgVersion1 > intgVersion2 then
      Result := -1
    else
      Result := 1;
  end;//if

end;

{
function GetFileVersion(var theVersionList: TStringList): Boolean;
const
  InfoNum = 11;
  InfoStr: array [1..InfoNum] of String = ('CompanyName', 'FileDescription', 'FileVersion', 'InternalName', 'LegalCopyright', 'LegalTradeMarks', 'OriginalFilename', 'ProductName', 'ProductVersion', 'Comments', 'Author');
  LabelStr: array [1..InfoNum] of String = ('Company Name', 'Description', 'File Version', 'Internal Name', 'Copyright', 'TradeMarks', 'Original File Name', 'Product Name', 'Product Version', 'Comments', 'Author');
var
  strFileName: AnsiString;
  intSize, intLength: Cardinal;
  intA: Integer;
  pchBuffer: PChar;
  pchValue: PChar;
begin

   if not Assigned(theVersionList) then
   begin
     Result := False;
     Exit;
   end;//if

   try
     strFileName := Application.ExeName;
     theVersionList.Clear;
     theVersionList.Sorted := True;
     intSize := GetFileVersionInfoSize(PChar(strFileName), intSize);
     if intSize > 0 Then
     begin

       pchBuffer := AllocMem(intSize) ;
       theVersionList.Add(StringPad('Size', ' ', 20, True) + ' = ' + IntToStr(intSize));
       GetFileVersionInfo(PChar(strFileName), 0, intSize, pchBuffer);

       for intA := 1 to InfoNum do
       begin

         if VerQueryValue(pchBuffer, PChar('StringFileInfo\040904E4\'+ InfoStr[intA]), Pointer(pchValue), intLength) then
         begin
           pchValue := PChar(Trim(pchValue));
           if Length(pchValue) > 0 then
           begin
             //theVersionList.Add(StringPad(LabelStr[intA], ' ', 20, True) + ' = ' + pchValue);
             theVersionList.Add(LabelStr[intA] + ' = ' + pchValue);
           end;//if
         end;//if
       end;//for

       FreeMem(pchBuffer, intSize);

     end
     else
     begin
       theVersionList.Add('No FileVersionInfo found') ;
     end;//if intSize

     Result := True;

   except
     Result := False;
   end;//try
end;
}

function GetFileVersion( strnFileName: AnsiString; var intgMajor, intgMinor, intgRelease, intgBuild: Integer ): Boolean;
var
  pvsfInfo: PVSFixedFileInfo;
  intgInfoSize: Uint;
  wordHandle: DWord;
  wordBufferSize: Dword;
  Buffer: Pointer;
begin

  wordBufferSize := GetFileVersionInfoSize( PChar( strnFileName ), wordHandle );
  Result := True;
  intgMajor := 0;
  intgMinor := 0;
  intgRelease := 0;
  intgBuild := 0;

  if wordBufferSize <> 0 then
  begin
    GetMem( Buffer, wordBufferSize);
    try
      if GetFileVersionInfo( PChar( strnFileName ), wordHandle, wordBufferSize, Buffer ) then
      begin
        if VerQueryValue( Buffer, '\', Pointer( pvsfInfo ), intgInfoSize ) then
        begin
          intgMajor := HiWord( pvsfInfo.dwFileVersionMS );
          intgMinor := LoWord( pvsfInfo.dwFileVersionMS );
          intgRelease := HiWord( pvsfInfo.dwFileVersionLS );
          intgBuild := LoWord( pvsfInfo.dwFileVersionLS );
        end
        else
        begin
          Result := False;
        end;
      end
      else
      begin
        Result := False;
      end;
    finally
      FreeMem( Buffer, wordBufferSize);
    end;
  end
  else
  begin
    Result := False;
  end;
end;

function GetVersionMajor(strFullVersion: ShortString; strSeparator: ShortString): ShortInt;
var
  wordValue: Word;
  intgCode: Integer;
begin
  try
    Val( ExtractSepValue( 1, strFullVersion, strSeparator ), wordValue, intgCode );
    Result := wordValue;
  except
    Result := -1;
  end;//try
end;

function GetVersionMinor(strFullVersion: ShortString; strSeparator: ShortString): ShortInt;
var
  wordValue: Word;
  intgCode: Integer;
begin
  try
    Val( ExtractSepValue( 2, strFullVersion, strSeparator ), wordValue, intgCode );
    Result := wordValue;
  except
    Result := -1;
  end;//try
end;

function GetVersionRelease(strFullVersion: ShortString; strSeparator: ShortString): ShortInt;
var
  wordValue: Word;
  intgCode: Integer;
begin
  try
    Val( ExtractSepValue( 3, strFullVersion, strSeparator ), wordValue, intgCode );
    Result := wordValue;
  except
    Result := -1;
  end;//try
end;

function GetVersionBuild(strFullVersion: ShortString; strSeparator: ShortString): ShortInt;
var
  wordValue: Word;
  intgCode: Integer;
begin
  try
    Val( ExtractSepValue( 4, strFullVersion, strSeparator ), wordValue, intgCode );
    Result := wordValue;
  except
    Result := -1;
  end;//try
end;


end.
